home *** CD-ROM | disk | FTP | other *** search
/ Point Programming 1 / PPROG1.ISO / pascal / swag / cursor.swg / 0002_CUSOR Handling #1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  2.6 KB  |  115 lines
  1. Unit cursor;
  2.  
  3. (*
  4.  *  CURSOR v1.1 - a Unit to provide extended control of cursor shape.
  5.  *
  6.  *  Public Domain 1991 by John Giesbrecht (1:247/128)
  7.  *
  8.  *  Notes:
  9.  *
  10.  *  - This version requires Turbo Pascal 6.0 or later.
  11.  *  - These routines affect only the cursor on page 0.
  12.  *  - This Unit installs an Exit Procedure which restores the cursor
  13.  *    to its original shape when the Programme terminates.
  14.  *)
  15.  
  16. Interface
  17.  
  18. Procedure cursoroff;
  19. Procedure cursoron;           (* original cursor shape *)
  20.  
  21. Procedure blockcursor;
  22. Procedure halfblockcursor;
  23. Procedure linecursor;         (* Default Dos cursor    *)
  24.  
  25. Procedure setcursor(startline, endline : Byte);
  26. Procedure getcursor(Var startline, endline : Byte);
  27.  
  28. (********************************************************************)
  29.  
  30. Implementation
  31.  
  32. Const
  33.   mono = 7;
  34.  
  35. Var
  36.   origstartline,
  37.   origendline,
  38.   mode : Byte;
  39.   origexitproc : Pointer;
  40.  
  41. (********************************************************************)
  42. Procedure setcursor(startline, endline : Byte); Assembler;
  43.  
  44. Asm
  45.   mov ah, $01
  46.   mov ch, startline
  47.   mov cl, endline
  48.   int $10
  49. end;
  50. (********************************************************************)
  51. Procedure getcursor(Var startline, endline : Byte); Assembler;
  52.  
  53. Asm
  54.   mov ah, $03
  55.   mov bh, $00
  56.   int $10
  57.   les di, startline
  58.   mov Byte ptr es:[di], ch
  59.   les di, endline
  60.   mov Byte ptr es:[di], cl
  61. end;
  62. (********************************************************************)
  63. Procedure cursoroff;
  64.  
  65. begin
  66.   setcursor(32, 32);
  67. end;
  68. (********************************************************************)
  69. Procedure cursoron;
  70.  
  71. begin
  72.   setcursor(origstartline, origendline);
  73. end;
  74. (********************************************************************)
  75. Procedure blockcursor;
  76.  
  77. begin
  78.   if mode = mono
  79.     then setcursor(1, 12)
  80.     else setcursor(1, 7);
  81. end;
  82. (********************************************************************)
  83. Procedure halfblockcursor;
  84.  
  85. begin
  86.   if mode = mono
  87.     then setcursor(7, 12)
  88.     else setcursor(4, 7);
  89. end;
  90. (********************************************************************)
  91. Procedure linecursor;
  92. begin
  93.   if mode = mono
  94.     then setcursor(11, 12)
  95.     else setcursor(6, 7);
  96. end;
  97. (********************************************************************)
  98. Procedure restorecursor; Far;
  99.  
  100. begin
  101.   system.exitproc := origexitproc;
  102.   cursoron;
  103. end;
  104. (**  I N I T I A L I Z A T I O N  ***********************************)
  105. begin
  106.  getcursor(origstartline, origendline);
  107.  Asm
  108.   mov ah, $0F
  109.   int $10
  110.   mov mode, al
  111.  end;
  112.  origexitproc := system.exitproc;
  113.  system.exitproc := addr(restorecursor);
  114. end.
  115.